fromP, toP: longint; (* max 8000 lines per model supported in this incarnation. *)
hs, vs, he, ve: integer; (* for fast drawing. buffers transformed locations *)
newline: boolean; (* for optimization. if true, no MoveTo required *)
newLineColor: boolean;
LineColor: RGBColor;
end;
LineBufPtr = ^LineBufRec;
LineBufRec = array[1..MaxLine] of LineEntry;
TSObject3D = object(TSGenericObject3D)
Lines: LineBufPtr;
numLines: integer;
AutoErase: Boolean;
UseBounds: Boolean;
procedure Init;
override;
function Clone: TGenericObject; {also clone line description buffer}
override;
procedure Reset;
override;
procedure Kill;
override;
function AddLine (fIndex, tIndex: longint): integer; {add line to objects database. returns line index or -1}
function ChangeLine (LineIndex, fIndex, tIndex: longint): boolean; {change line description of line with index }
{lineIndex. True if successful }
function ChangeLineColor (LineIndex: longint; theColor: RGBColor): boolean;
{change the color from this line on for all following }
{until the next ChangeColor command }
function GetLineColor (LineIndex: longint; var theColor: RGBColor; var ChangeHere: boolean): Boolean;
{returns the currently active color of specified line}
function KeepLineColor (LineIndex: longint): boolean; {deletes change linecolor information. This line and }
{all following will have the same color as the pre- }
{vious }
function DeleteLine (LineIndex: integer): Boolean; {delete whole line from model. True on success}
function DeletePoint (index: longint): boolean; {override inherited proc of this kind. This one checks}
override; {first if point is referenced to by a point. If so, it }
{returns false and doesn't delete the point }
procedure GetLine (lineIndex: integer; var src, tgt: LongInt); {returns start and endpoint of line}
procedure BuildNewLines; {should not be called from the outside}
procedure CollectLineData; {internal use only. fill the screen vals from point definition into line array}
procedure SetAutoerase (TurnOn: Boolean); {controls setting of autoerase flag if switched on, }
{this procedure will initialize the oldBounds var }
procedure SetUseBounds (TurnOn: Boolean); {tells Draw and fDraw to collect bouding box data}
procedure Draw; {recalcs if neccessary, erases old image if auto- }
override; {erase on, redraws all objects lines }
procedure fDraw; {like Draw but it collects data prior to drawing }
{thus making the actual drawing process a bit }
{faster but the whole call is slower than Draw }
procedure Erase; {erase image of myself. this calcs and uses bounds}
end;
{Global Procedures for GrafSys}
procedure InitGrafSys;
procedure ArithmeticClip (var startV, endV: Point3DEntry; var skipThis, clippedThis: boolean; var sx, sy, ex, ey: integer); {arithmetically clips a line that connects startV,endV }
{if it intersects the Z=0 plane. If it is completely behind }
{the Z=0 plane, skipThis is TRUE, if it intersects with }
{the plane, clippedThis becomes true and sx..ey contain}
{the new screen coordinates }
implementation
type
screenBuffer = array[1..MaxLine] of record
sx, sy: integer;
ex, ey: integer;
newLine: boolean;
newLineColor: boolean;
LineColor: RGBColor;
end;
screenBufPtr = ^screenBuffer;
var
theBlack: RGBColor;
lineBuffer: screenBufPtr;
center: Point; (* screen center in local coords of current 3d grafport *)
thed: real;
screenBufNumLines: integer; (* number of lines in scren buffer *)